COMMENT ⊗   VALID 00005 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	BEGIN "NTONIC"
C00003 00003	DEFINE NEL=14, N=4, NOPEN=4
C00006 00004	INTEGER DONE,FOO,I,J,K,L
C00009 00005	WIREIT
C00015 ENDMK
C⊗;
BEGIN "NTONIC"
REQUIRE "DDSUB.SAI[GRA,HPM]" SOURCE_FILE;
REQUIRE "PRANDR.SAI[BIG,HPM]" SOURCE_FILE;
INTEGER XXTN;
DEFINE NEL=14, N=4, NOPEN=4;

INTEGER ARRAY WIRE[0:N-1,0:NEL-1],STATE[0:N-1,0:NEL-1],NSIZ,NSET[0:NEL-1];
INTEGER ARRAY NEXT,PERM,OUTPUT,INPUTMAP[0:N*NOPEN-1];
REAL ARRAY X,Y[0:NEL-1];

PROCEDURE WIREIT;
   BEGIN
   INTEGER I,J,K,L,M;

   PROCEDURE SET(INTEGER L; REAL XV,YV);
      BEGIN X[L]←XV; Y[L]←YV; XXTN←XXTN MAX X[L]+1; END;

   PROCEDURE M4WAY(INTEGER FIRST; INTEGER ARRAY NEXT);
      BEGIN
      INTEGER I,J;
      FOR I←0 STEP 1 UNTIL N-1 DO FOR J←0 STEP 1 UNTIL N-1 DO
         WIRE[J,I+FIRST]←NEXT[J+4*I];
      END;

   XXTN←0;
   FOR I←0 STEP 1 UNTIL NOPEN-1 DO SET(I,1,I+1);
   SET(8,2,3.7); SET(7,2,3.2); SET(6,2,2.5);
   SET(5,2,1.8); SET(4,2,1.3);
   SET(9,3,1.5); SET(10,3,2.5); SET(11,3,3.5);
   SET(12,4,2); SET(13,4,3);

   FOR J←0 STEP 1 UNTIL 15 DO INPUTMAP[J]←J MOD 4;
   OUTSTR("INPUTMAP ");
   FOR I←0 STEP 1 UNTIL N*NOPEN-1 DO OUTSTR(CVS(INPUTMAP[I])&" "); OUTSTR('15&'12);

   FOR I←0 STEP 1 UNTIL NEL-1 DO NSIZ[I]←4;
   NSIZ[12]←NSIZ[13]←NSIZ[4]←NSIZ[8]←2; NSIZ[5]←NSIZ[7]←3;

   NEXT[0]←-1;
   NEXT[1]←NEXT[4]←4;
   NEXT[2]←NEXT[5]←NEXT[8]←5;
   NEXT[3]←NEXT[6]←NEXT[9]←NEXT[12]←6;
   NEXT[7]←NEXT[10]←NEXT[13]←7;
   NEXT[11]←NEXT[14]←8;
   NEXT[15]←-16; 
   M4WAY(0,NEXT);
   WIRE[0,4]←-2; WIRE[1,4]←WIRE[0,5]←WIRE[1,5]←WIRE[0,6]←9;
   WIRE[2,5]←WIRE[1,6]←WIRE[2,6]←WIRE[0,7]←10;
   WIRE[3,6]←WIRE[1,7]←WIRE[2,7]←WIRE[0,8]←11; WIRE[1,8]←-15;

   K←-2;
   FOR I←9 STEP 1 UNTIL 11 DO FOR J←0 STEP 1 UNTIL NSIZ[I]-1 DO WIRE[J,I]←K←K-1;
   WIRE[3,9]←WIRE[0,10]←12; WIRE[3,10]←WIRE[0,11]←13;
   WIRE[0,12]←-6; WIRE[1,12]←-7; WIRE[0,13]←-10; WIRE[1,13]←-11;
   END;
INTEGER DONE,FOO,I,J,K,L;
STRING S; BOOLEAN MERGE,PASS;

PROCEDURE FOLLOW;
   BEGIN
   INTEGER I,J,K,L;
   DONE←0;
   WHILE DONE<NEL DO FOR I←0 STEP 1 UNTIL NEL-1 DO IF NSET[I]=NSIZ[I] THEN
      BEGIN
      FOR J←1 STEP 1 UNTIL NSIZ[I]-1 DO FOR K←0 STEP 1 UNTIL J-1 DO
         IF STATE[J,I]<STATE[K,I] THEN STATE[J,I]↔STATE[K,I];
      FOR J←0 STEP 1 UNTIL NSIZ[I]-1 DO
         BEGIN
         K←WIRE[J,I];
         IF K≥0 THEN
            BEGIN
            L←NSET[K];
            NSET[K]←L+1;
            STATE[L,K]←STATE[J,I];
            END
         ELSE
            OUTPUT[-1-K]←STATE[J,I];
         END;
      NSET[I]←-NSIZ[I];
      DONE←DONE+1;
      END;
   END;

PROCEDURE DRAW;
   BEGIN
   INTEGER I,J,K;
   DDINIT;
   SCREEN(-1,-.1,XXTN+2,NOPEN+2);
   DRKEN; RECTAN(-100,-100,100,100); LITEN;
   FOR I←0 STEP 1 UNTIL NEL-1 DO
      RECTAN(X[I]-.1,Y[I]-.2*NSIZ[I]/N,X[I]+.2,Y[I]+.2*NSIZ[I]/N);
   FOR I←0 STEP 1 UNTIL N*NOPEN-1 DO
      LINE(0,I*(NOPEN+1)/(N*NOPEN-1),X[INPUTMAP[I]],Y[INPUTMAP[I]]);
   FOR I←0 STEP 1 UNTIL NEL-1 DO
   FOR J←0 STEP 1 UNTIL NSIZ[I]-1 DO
      BEGIN REAL FX,FY;
      FX←X[I]+.2; FY←Y[I]+NSIZ[I]*(J/(NSIZ[I]-1)-.5)*.4/N;
      IF WIRE[J,I]<0 THEN LINE(FX,FY,XXTN,(-1-WIRE[J,I])*(NOPEN+1)/(N*NOPEN-1))
         ELSE LINE(FX,FY,X[WIRE[J,I]],Y[WIRE[J,I]]);
      END;
   FOR I←1,2,3 DO DPYUP('36);
   SHOW('36);
   END;
WIREIT;
DRAW;

   BEGIN
   INTEGER ARRAY CNTR[1:N*NOPEN];
   INTEGER ARRAY CHECK[0:N*NOPEN,0:N*NOPEN];
   FOR I←1 STEP 1 UNTIL N*NOPEN DO CNTR[I]←(N*NOPEN-I)%NOPEN;
   MERGE←TRUE;
   DO
      BEGIN
      K←-1;
      FOR I←N-1 STEP -1 UNTIL 0 DO FOR J←1 STEP 1 UNTIL N*NOPEN DO
         IF CNTR[J]=I THEN PERM[K←K+1]←J;
      FOR I←0 STEP 1 UNTIL NEL-1 DO NSET[I]←0;
      FOR I←0 STEP 1 UNTIL N*NOPEN-1 DO
         BEGIN
         K←INPUTMAP[I];
         L←NSET[K];
         NSET[K]←L+1;
         STATE[L,K]←PERM[I];
         END;
      FOLLOW;
      PASS←FALSE;
      FOR K←0 STEP 1 UNTIL N*NOPEN-1 DO
         BEGIN
         L←0; WHILE CHECK[K,L]≠0∧CHECK[K,L]<OUTPUT[K] DO L←L+1;
         IF CHECK[K,L]≠OUTPUT[K] THEN
            BEGIN
            WHILE OUTPUT[K]≠0 DO
               BEGIN
               CHECK[K,L]↔OUTPUT[K];
               L←L+1;
               END;
            PASS←TRUE;
            END;
         END;
      IF PASS THEN
         BEGIN
         DRKEN; RECTAN(XXTN+.01,-100,100,100); LITEN;
         FOR K←0 STEP 1 UNTIL N*NOPEN-1 DO
            BEGIN
            TXTPOS(XXTN+.01,(N*NOPEN-1-K-.5)*5/15+.2,.1,.2);
            L←0; WHILE CHECK[K,L]≠0 DO TEXT('77+CHECK[K,(L←L+1)-1]);
            END;
         DPYUP('36);
         END;
      PWITHR(CNTR,N*NOPEN,MERGE);
      END UNTIL MERGE;
   END;

END;